home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 26
/
Cream of the Crop 26.iso
/
program
/
p063b9s.zip
/
UNIT
/
PROTOCOL.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1997-03-02
|
28KB
|
970 lines
UNIT Protocol;
{╔══════════════════════════════════════════════════════════════════════════╗}
{║ Y/XModem, Sea/TeLink & Modem7 send/receive Last changed: 02.03.97 SA ║}
{║ ║}
{║ (C) Copyright 1989-97 by ║}
{║ Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager ║}
{║ ║}
{║ This source may not be given to anybody, without the written permission ║}
{║ from The Portal Team. ║}
{╚══════════════════════════════════════════════════════════════════════════╝}
{$I POPDEFS.INC}
INTERFACE
USES Use32, Dos;
CONST
FinalName : PathStr='';
TYPE
ProtocolType = (YModem, XModem, SeaLink, TeLink, Modem7, _f, _b);
FUNCTION ReceiveFile(CONST FPath, FName: PathStr; Protocol: ProtocolType) : Integer;
FUNCTION SendFile(CONST FName, Alias : PathStr; Protocol: ProtocolType) : Integer;
IMPLEMENTATION
USES OpCrt, OpString, OpDate, ApTimer,
Globals, Com, Modem, PoPTypes, Crc, Util, StrUtil, Mailutil,
FileUtil, TransVid, LogFile;
CONST
SendACKLess : Boolean = False;
NoOverdrive : Boolean = True;
OverWrite : Boolean = False;
SmallWindow : Boolean = True;
TYPE
HeaderType = RECORD
FSize,
FTime : LongInt;
FName : String[16];
Moi : String[14];
NoACKs : Byte;
END;
{-=-=-=-=-=-=-}
CONST
NetMail : Boolean=False;
VAR
FileSecs : LongInt;
_FPath : PathStr;
Header : HeaderType;
BlockSize, FirstBlock,
FSize2, BlockNumber, BaseBlock, FSize1 : Word;
Errs, RealErrs : Byte;
StatMsg : S80;
DidNAK : Byte;
Buffer : Pointer;
Sliding, DoChkSum, RecvACKLess : Boolean;
InFile : FILE;
PROCEDURE SendACK;
BEGIN
IF (NOT RecvACKLess) OR (BlockNumber=0) THEN
BEGIN
ComPort^.WriteByte(Ack, False);
IF Sliding THEN
BEGIN
ComPort^.WriteByte(Lo(BlockNumber), False);
ComPort^.WriteByte(Lo(NOT(BlockNumber)), False);
END;
ComPort^.FlushTx;
IF BlockNumber <= FSize1 THEN ShowCurrentByte(LongInt(BlockNumber) * LongInt(BlockSize),false);
END ELSE
BEGIN
IF (((NOT BlockNumber AND $1f)=0) AND (BlockNumber<FSize1)) OR (BlockNumber=FSize1) THEN
ShowCurrentByte(LongInt(BlockNumber) * LongInt(BlockSize),false);
END;
Errs:=0;
END;
PROCEDURE SendNAK;
VAR
t1 : EventTimer;
i : Integer;
BEGIN
Inc(Errs);
Inc(RealErrs);
IF Errs > 6 THEN
BEGIN
StatMsg:='FUBAR....';
Exit;
END;
Inc(DidNAK);
IF DidNAK > 8 THEN RecvACKLess:=False;
ComPort^.PurgeIn;
IF NOT RecvACKLess THEN
BEGIN
NewTimerSecs(t1, 30);
IF (BaseBlock <> BlockNumber) OR (Errs > 1) THEN
BEGIN
REPEAT
i:=TimedRead(100);
IF NOT ComPort^.Carrier THEN Exit;
IF TimerExpired(t1) THEN Break;
UNTIL i<0;
END;
END;
IF BlockNumber > BaseBlock THEN
ComPort^.WriteByte(Nak, True)
ELSE
IF (Errs<5) AND (not DoChkSum) THEN
ComPort^.WriteByte(Byte('C'), True)
ELSE
BEGIN
DoChkSum:=True;
ComPort^.WriteByte(Nak, True);
END;
IF Sliding THEN
BEGIN
ComPort^.WriteByte(Lo(BlockNumber), False);
ComPort^.WriteByte(Lo(NOT BlockNumber), True);
END;
IF BlockNumber <= FSize1 THEN ShowCurrentByte(LongInt(BlockNumber) * LongInt(BlockSize),false);
END;
PROCEDURE GetBlock;
VAR
SPtr : String;
Written, Crc : Word;
chksum : Byte;
BlockErr : Byte;
IsResend : Boolean;
msb, lsb, i, InChar : Integer;
BEGIN
BlockErr:=0; IsResend:=False;
InChar:=TimedRead(500);
IF InChar <> Lo(BlockNumber) THEN
IF InChar<Integer(BlockNumber) THEN IsResend:=True ELSE
IF (BlockNumber > 0) OR (InChar <> 1) THEN
BEGIN
Inc(BlockErr);
StatMsg:='Sync';
END ELSE BlockNumber:=1;
i:=TimedRead(500);
IF Lo(i) <> Lo(NOT InChar) THEN
BEGIN
Inc(BlockErr);
StatMsg:='Complement';
END;
FOR i:=0 TO BlockSize - 1 DO
BEGIN
InChar:=TimedRead(500);
IF InChar<0 THEN
BEGIN
IF ComPort^.Carrier THEN
BEGIN
SendNAK;
StatMsg:='Timeout';
END;
Exit;
END;
BT0(Buffer^)[i]:=Lo(InChar);
END;
IF DoChkSum THEN
BEGIN
ChkSum:=0;
FOR i:=0 TO BlockSize - 1 DO
Inc(chksum, BT0(Buffer^)[i]);
IF Lo(TimedRead(500)) <> chksum THEN
BEGIN
StatMsg:='ChkSum Error';
Inc(BlockErr);
END;
END ELSE
BEGIN
Crc:=0;
FOR i:=0 TO BlockSize - 1 DO
Crc:=UpdCrc16(BT0(Buffer^)[i], Crc);
Crc:=UpdCrc16(0, Crc);
Crc:=UpdCrc16(0, Crc);
msb:=TimedRead(300);
lsb:=TimedRead(300);
IF (lsb<0) OR (msb<0) THEN
BEGIN
StatMsg:='Short block';
IF BlockNumber=0 THEN Sliding:=False;
Inc(BlockErr);
END ELSE
IF (Lo(msb) SHL 8) + Lo(lsb) <> Crc THEN
BEGIN
StatMsg:='CRC Error';
Inc(BlockErr);
END;
END;
IF BlockErr > 0 THEN SendNAK ELSE
BEGIN
SendACK;
IF IsResend THEN Exit;
IF BlockNumber > 0 THEN
BEGIN
IF BlockNumber <= FSize1 THEN
BlockWrite(InFile, Buffer^, BlockSize, Written)
ELSE
BlockWrite(InFile, Buffer^, FSize2, Written);
IF FirstBlock > 0 THEN
BEGIN
{ check nodelist }
END;
END ELSE
BEGIN
Move(Buffer^, Header, SizeOf(Header));
IF FirstBlock=0 THEN
BEGIN
SPtr:=Asciiz2Str(Header.FName, 17);
IF NetMail THEN SPtr:=InventPktName;
FOR i:=Length(SPtr) DOWNTO 1 DO
IF SPtr[i] <= ' ' THEN SPtr[0]:=Char(i - 1);
IF SPtr <> '' THEN
BEGIN
FinalName:=_FPath + SPtr;
SPtr:=FinalName;
i:=Length(FinalName);
{ IF NetMail THEN p:=CheckNetFile(Sptr) ELSE p:=Receiving;}
ShowCurrentFilename(SPtr,0,Header.FSize,90,false);
END ELSE
AddLog('!', 'Grunged hdr');
END;
IF Header.FSize <> 0 THEN
BEGIN
FSize1:=LongInt(Header.FSize DIV 128);
FSize2:=LongInt(Header.FSize MOD 128);
END;
IF Header.FTime <> 0 THEN FileSecs:=Header.FTime ELSE FileSecs:=- 1;
IF Asciiz2Str(Header.Moi, 15) <> '' THEN ShowError('From: '+Asciiz2Str(Header.Moi, 15),False,true,false);
IF (ComPort^.GetBaudRate >= 9600) AND (Header.NoACKs <> 0) AND (NOT NoOverdrive) THEN
RecvACKLess:=True;
ShowBlockSize(BlockSize,false);
END;
Inc(BlockNumber);
END;
END;
FUNCTION ReceiveFile(CONST FPath, FName: PathStr; Protocol: ProtocolType) : Integer;
LABEL
Lost, LoopTop, FUBAR, Done;
VAR
TmpName : PathStr;
k, MayBeSeadog : Boolean;
i, j : Byte;
InChar : Integer;
t1 : EventTimer;
Srec : SEARCHREC;
BEGIN
DidNAK:=0; FileSecs:=- 1; Errs:=0; RealErrs:=0;
RecvACKLess:=False;
ComPort^.SetXOn(Off);
IF Protocol=_f THEN
BEGIN
MayBeSeadog:=True;
NetMail:=False;
Protocol:=SeaLink;
FirstBlock:=0;
END ELSE
IF Protocol=_b THEN
BEGIN
Protocol:=SeaLink;
NetMail:=True;
MayBeSeadog:=True;
FirstBlock:=1;
END ELSE
BEGIN
MayBeSeadog:=False;
NetMail:=False;
FirstBlock:=0;
END;
FSize1:=65535;
_FPath:=AddBackSlash(FPath);
{ FOR InChar:=1 TO Length(FName) DO
IF FName[InChar] IN ['*', '?'] THEN FName:='';}
Sliding:=True;
BaseBlock:=0; DoChkSum:=False;
BlockSize:=128;
CASE Protocol OF
XModem : BEGIN
BaseBlock:=1;
Sliding:=False;
ShowErrorCheckingMethod('XModem Receive',false);
END;
YModem : BEGIN
BaseBlock:=1;
Sliding:=False;
BlockSize:=1024;
ShowErrorCheckingMethod('YModem Receive',false);
END;
SeaLink: ShowErrorCheckingMethod('SeaLink Receive',false);
TeLink : ShowErrorCheckingMethod('TeLink Receive',false);
Modem7 : BEGIN
BaseBlock:=1;
Sliding:=False;
ShowErrorCheckingMethod('Modem7 Receive',false);
END;
END;
ShowBlockSize(BlockSize,false);
BlockNumber:=BaseBlock;
TmpName:=_FPath + '_TMP_.$$$';
IF (Pos(FName, '*')=0) AND (Pos(FName, '?')=0) THEN FinalName:=_FPath+FName ELSE FinalName:=_FPath+'UNKNOWN.$$$';
Assign(InFile, TmpName);
Rewrite(InFile, 1);
IF IoResult <> 0 THEN
BEGIN
ShowError('Can''t open file',True,true,false);
ReceiveFile:=0;
Exit;
END;
{check for tty}
GetMem(Buffer, 1024);
StatMsg:='';
IF NOT MayBeSeadog THEN SendNAK;
NewTimerSecs(t1, 3);
RealErrs:=0;
LoopTop:
IF GotESC THEN
BEGIN
StatMsg:='Keyboard Escape';
GOTO FUBAR;
END;
InChar:=TimedRead(400);
CASE Lo(InChar) OF
Soh : BEGIN
BlockSize:=128;
GetBlock;
NewTimerSecs(t1, 3);
END;
Stx : BEGIN
BlockSize:=1024;
GetBlock;
NewTimerSecs(t1, 3);
END;
Syn : BEGIN
DoChkSum:=True;
GetBlock;
DoChkSum:=False;
NewTimerSecs(t1, 3);
END;
Can : BEGIN
IF TimedRead(200)=Can THEN
BEGIN
StatMsg:='Got CAN';
GOTO FUBAR;
END;
NewTimerSecs(t1, 3);
END;
Eot : BEGIN
StatMsg:='End of transfer';
NewTimer(t1, 2);
WHILE NOT TimerExpired(t1) DO
TimedRead(0);
IF BlockNumber > 0 THEN GOTO Done ELSE GOTO FUBAR;
END;
ELSE BEGIN
IF InChar > 0 THEN
BEGIN
IF NOT MayBeSeadog THEN ShowError('???',True,false,false);
END ELSE
IF NOT ComPort^.Carrier THEN GOTO Lost;
IF (TimerExpired(t1)) OR (NOT MayBeSeadog) THEN SendNAK;
END;
END;
IF Errs > 14 THEN
BEGIN
StatMsg:='FUBAR...';
GOTO FUBAR;
END;
IF StatMsg <> '' THEN
BEGIN
ShowError(StatMsg,True,false,false);
StatMsg:='';
END;
GOTO LoopTop;
Lost:
StatMsg:='Carrier Lost';
FUBAR:
Close(InFile);
DeleteFile(TmpName);
ComPort^.PurgeOut;
IF StatMsg <> 'End of transfer' THEN
BEGIN
FOR InChar:=0 TO 4 DO
ComPort^.WriteByte(Can, InChar=4);
AddLog('!', 'File not received ...');
END;
ComPort^.PurgeIn;
FreeMem(Buffer, 1024);
ReceiveFile:=0;
Exit;
Done:
RecvACKLess:=False;
SendACK;
Close(InFile);
i:=Length(TmpName);
j:=Length(FinalName);
IF TmpName[i]='.' THEN Delete(TmpName, i, 1);
IF FinalName[j]='.' THEN
BEGIN
Delete(FinalName, j, 1);
Dec(j);
END;
i:=0;
k:=False; {IsArcMail(FinalName,j)}
IF (NOT OverWrite) OR (k) THEN
BEGIN
WHILE NOT RenameFile(TmpName, FinalName) DO
BEGIN
IF FinalName[j] IN ['0'..'9'] THEN FinalName[j]:=Char(Byte(FinalName[j]) + 1) ELSE
FinalName[j]:='0';
IF NOT(FinalName[j] IN ['0'..'9']) THEN
BEGIN
FinalName:=TmpName;
ReceiveFile:=1;
Exit;
END;
i:=1;
END;
END ELSE
BEGIN
DeleteFile(FinalName);
RenameFile(TmpName, FinalName);
END;
IF i <> 0 THEN AddLog('+', 'Dupe file renamed: ' + FinalName);
FINDFIRST(FinalName, AnyFile, Srec);
IF DOSERROR=0 THEN
BEGIN
IF FileSecs <> - 1 THEN
BEGIN
ASSIGN(InFile,FinalName); FileMode:=ShareRW+ShareDenyRW;
RESET(InFile);
SetFTime(InFile,FileSecs);
CLOSE(InFile);
END;
IF RealErrs > 4 THEN AddLog('+', 'Corrected %d errors in %d blocks');
AddLog('+', 'Received-S ' + FinalName);
FinalName:=Srec.Name;
ReceiveFile:=1;
FindClose(Srec);
Exit;
END;
FindClose(SRec);
FreeMem(Buffer, 1024);
ReceiveFile:=0;
END;
{-=-=-=-=-=-=-}
FUNCTION SendFile(CONST FName, Alias: PathStr; Protocol: ProtocolType) : Integer;
LABEL
Continue, FUBAR, SendLoop, SlideReply, Done, Reply, GoHome;
VAR
test, Errs : Word;
Header : HeaderType;
OutFile : FILE;
BlockTimer : EventTimer;
Message : String;
Buffer : Pointer;
Temp, LastBlock,
BlkNum,
ACKBlock : LongInt;
Srec : SEARCHREC;
AcklessOk, DoChkSum, Sliding, MayBeSeadog : Boolean;
WinSize, i, j, SendTmp,
InChar, InChar1, Base,
BlockSize,RealErrs,
FullWindow,
ACKErr : Integer;
Head, chksum : Byte;
Crc16 : Word;
BEGIN
IF Protocol=_f THEN
BEGIN
Protocol:=SeaLink;
MayBeSeadog:=True;
END ELSE
MayBeSeadog:=False;
Sliding:=False; ACKBlock:=- 1; DoChkSum:=False; Errs:=0; ACKErr:=0; RealErrs:=0;
FullWindow:=ComPort^.GetBaudRate DIV 400;
IF (SmallWindow) AND (FullWindow > 6) THEN FullWindow:=6;
ComPort^.SetXOn(Off);
IF FName='' THEN
BEGIN
ComPort^.PurgeIn;
FOR i:=1 TO 4 DO
BEGIN
InChar:=TimedRead(700);
CASE InChar OF
67,
Nak,
Can : ComPort^.WriteByte(Eot, True);
TSync : BEGIN
SendFile:=TSync;
Exit;
END;
ELSE IF InChar<32 THEN
BEGIN
SendFile:=0;
Exit;
END;
END;
END;
SendFile:=0;
Exit;
END;
{ FName:=StLoCase(FName);}
FINDFIRST(FName, AnyFile, Srec);
IF DOSERROR <> 0 THEN
BEGIN
AddLog('!', FName + ' not found');
{SendCan;}
SendFile:=0;
FindClose(Srec);
Exit;
END;
FindClose(SRec);
{ Check for TTY }
BlockSize:=128;
Head:=Soh;
Base:=1;
CASE Protocol OF
YModem : BEGIN
BlockSize:=1024;
Head:=Stx;
END;
SeaLink : Base:=0;
TeLink : BEGIN
Base:=0;
Head:=Syn;
END;
END;
GetMem(Buffer, BlockSize);
BlkNum:=Base;
LastBlock:=((Srec.size + (BlockSize - 1)) DIV BlockSize);
ShowCurrentFileName(JustFileName(FName),0,SRec.Size,90,false);
CASE Protocol OF
YModem : ShowErrorCheckingMethod('YModem Send',false);
XModem : ShowErrorCheckingMethod('XModem Send',false);
SeaLink : ShowErrorCheckingMethod('SeaLink Send',false);
TeLink : ShowErrorCheckingMethod('TeLink Send',false);
Modem7 : ShowErrorCheckingMethod('Modem7 Send',false);
END;
ShowBlockSize(BlockSize,false);
Assign(OutFile, FName); FileMode:=ShareRead+ShareDenyW;
Reset(OutFile, 1);
REPEAT
Continue:
DoChkSum:=False;
i:=TimedRead(900);
CASE i OF
Nak,
67 : BEGIN
DoChkSum:=(i=Nak);
SendTmp:=TimedRead(400);
IF (SendTmp >= 0) AND (TimedRead(200)=(Not(Lo(SendTmp)))) THEN
IF SendTmp <= 1 THEN Sliding:=True ELSE
BEGIN
ComPort^.WriteByte(Eot, True);
GOTO Continue;
END;
IF MayBeSeadog THEN Sliding:=True;
Errs:=0;
ComPort^.PurgeIn;
{start timer...}
GOTO SendLoop;
END;
Can : BEGIN
Message:='Cancelled';
GOTO FUBAR;
END;
ELSE BEGIN
IF GotESC THEN
BEGIN
Message:='Keyboard escape';
GOTO FUBAR;
END ELSE
BEGIN
Inc(Errs);
IF Errs > 15 THEN
BEGIN
Message:='Timeout';
GOTO FUBAR;
END;
END;
NewTimer(BlockTimer, 9);
WHILE NOT TimerExpired(BlockTimer) DO
;
ComPort^.PurgeIn;
END;
END;
UNTIL NOT ComPort^.Carrier;
Message:='No carrier';
GOTO FUBAR;
SendLoop:
WHILE ComPort^.Carrier DO
BEGIN
Message:='';
IF BlkNum<2 THEN WinSize:=2 ELSE
IF SendACKLess THEN WinSize:=220 ELSE WinSize:=FullWindow;
IF GotESC THEN
BEGIN
Message:='Keyboard Escape';
GOTO FUBAR;
END;
IF BlkNum <= LastBlock THEN
BEGIN
IF BlkNum > 0 THEN
BEGIN
Seek(OutFile, (BlkNum - 1) * BlockSize);
IF IoResult <> 0 THEN
BEGIN
Message:='Seek error';
GOTO FUBAR;
END;
FillChar(Buffer^, BlockSize, 0);
BlockRead(OutFile, Buffer^, BlockSize, test);
ShowCurrentByte(FilePos(OutFile),false);
IF IoResult <> 0 THEN
BEGIN
Message:='Read error';
GOTO FUBAR;
END;
END ELSE
BEGIN
BlockSize:=128;
FillChar(Header, SizeOf(Header), 0);
Header.FSize:=Srec.size;
Header.FTime:=Srec.Time;
IF Alias='' THEN
Str2AsciiZ(JustFileName(StLoCase(FName)), Header.FName,17)
ELSE
Str2AsciiZ(JustFileName(Alias), Header.FName,17);
IF Protocol=TeLink THEN
BEGIN
FOR i:=0 TO 16 DO
IF Header.FName[i]=#0 THEN Header.FName[i]:=' ';
Header.FTime:=Srec.Time;
END;
Str2AsciiZ('Portal', Header.Moi,15);
IF (ComPort^.GetBaudRate >= 9600) AND (Sliding) AND (NOT NoOverdrive) THEN
BEGIN
Header.NoACKs:=1;
SendACKLess:=True;
END ELSE
BEGIN
Header.NoACKs:=0;
SendACKLess:=False;
END;
AcklessOk:=False;
FillChar(Buffer^,BlockSize,0);
Move(Header, Buffer^, SizeOf(Header));
END;
ComPort^.WriteByte(Head, False);
ComPort^.WriteByte(Lo(BlkNum), False);
ComPort^.WriteByte(NOT(Lo(BlkNum)), False);
FOR i:=0 TO BlockSize - 1 DO
ComPort^.WriteByte(BT0(Buffer^)[i], False);
IF (DoChkSum) OR (Head=Syn) THEN
BEGIN
chksum:=0;
FOR i:=0 TO BlockSize - 1 DO
Inc(chksum, BT0(Buffer^)[i]);
ComPort^.WriteByte(chksum, True);
END ELSE
BEGIN
Crc16:=0;
FOR i:=0 TO BlockSize - 1 DO
Crc16:=UpdCrc16(BT0(Buffer^)[i], Crc16);
Crc16:=UpdCrc16(0, Crc16);
Crc16:=UpdCrc16(0, Crc16);
ComPort^.WriteByte(Hi(Crc16), False);
ComPort^.WriteByte(Lo(Crc16), True);
END;
END;
NewTimerSecs(BlockTimer, 30);
SlideReply:
IF NOT Sliding THEN
BEGIN
WHILE NOT ComPort^.OutEmpty DO
;
NewTimerSecs(BlockTimer, 30);
END ELSE
IF ((BlkNum<(ACKBlock + WinSize)) AND (BlkNum<LastBlock) AND (NOT ComPort^.KeyPressed)) THEN
BEGIN
IF (SendACKLess) AND (BlkNum > 0) THEN
BEGIN
ACKBlock:=BlkNum;
IF BlkNum >= LastBlock THEN
BEGIN
IF AcklessOk THEN
BEGIN
{ write something??? }
GOTO Done;
END;
BlkNum:=LastBlock + 1;
GOTO SendLoop;
END;
Inc(BlkNum);
IF (BlkNum AND $1f)=0 THEN
BEGIN
{ update SLO display!!! }
END;
END ELSE
Inc(BlkNum);
GOTO SendLoop;
END;
IF NOT ComPort^.KeyPressed THEN
BEGIN
IF SendACKLess THEN
BEGIN
ACKBlock:=BlkNum;
IF BlkNum >= LastBlock THEN
BEGIN
IF AcklessOk THEN
BEGIN
{ write something AGAIN!!! }
GOTO Done;
END;
BlkNum:=LastBlock + 1;
GOTO SendLoop;
END;
Inc(BlkNum);
IF (BlkNum MOD 32)=0 THEN
BEGIN
{ write again.... }
END;
GOTO SendLoop;
END;
END;
Reply:
WHILE (NOT ComPort^.OutEmpty) AND (NOT ComPort^.KeyPressed) DO
;
InChar:=TimedRead(3000);
IF InChar<0 THEN
BEGIN
Message:='Timeout';
GOTO FUBAR;
END;
IF InChar=67 THEN
BEGIN
DoChkSum:=False;
InChar:=Nak;
END;
IF InChar=Can THEN
BEGIN
Message:='Cancelled';
GOTO FUBAR;
END;
IF (InChar > 0) AND (Sliding) THEN
BEGIN
Inc(ACKErr);
IF ACKErr >= 10 THEN
BEGIN
IF SendACKLess THEN
BEGIN
SendACKLess:=False;
Message:='No acks??????';
END;
END;
IF (InChar=Ack) OR (InChar=Nak) THEN
BEGIN
i:=TimedRead(400);
IF i<0 THEN
BEGIN
Sliding:=False;
IF SendACKLess THEN
BEGIN
SendACKLess:=False;
Message:='No acks????';
END;
END ELSE
BEGIN
j:=TimedRead(200);
IF j<0 THEN
BEGIN
Sliding:=False;
IF SendACKLess THEN
BEGIN
SendACKLess:=False;
Message:='No Acks!?!?!?!';
END;
END ELSE
BEGIN
IF i=(j XOR $ff) THEN
BEGIN
Temp:=BlkNum - (Lo(BlkNum - i));
IF ((Temp <= BlkNum) AND (Temp > (BlkNum - WinSize - 10))) THEN
BEGIN
IF InChar=Ack THEN
BEGIN
IF ((Head=Syn) AND (BlkNum > 0)) THEN Head:=Soh;
IF SendACKLess THEN
BEGIN
AcklessOk:=True;
GOTO SlideReply;
END ELSE
ACKBlock:=Temp;
Inc(BlkNum);
IF ACKBlock >= LastBlock THEN GOTO Done;
Errs:=0;
END ELSE
BEGIN
BlkNum:=Temp;
ComPort^.PurgeOut;
Inc(Errs);
Inc(RealErrs);
END;
END;
END ELSE
BEGIN
Message:='Slide Cmpl Err';
END;
END;
END;
END ELSE
BEGIN
ShowError('Debris',True,false,false);
IF (TimerExpired(BlockTimer)) AND (ComPort^.OutEmpty) THEN
BEGIN
Message:='TimeOut';
GOTO FUBAR;
END ELSE
IF NOT ComPort^.OutEmpty THEN NewTimerSecs(BlockTimer, 30);
GOTO SlideReply;
END;
END;
IF NOT Sliding THEN
BEGIN
IF InChar=Ack THEN
BEGIN
IF BlkNum=10 THEN Pause(3);
IF ComPort^.KeyPressed THEN
BEGIN
SendTmp:=TimedRead(400);
IF (SendTmp >= 0) AND (TimedRead(200)=(NOT(Lo(SendTmp)))) THEN
BEGIN
Sliding:=True;
ACKBlock:=SendTmp;
END;
END;
Message:='';
IF BlkNum >= LastBlock THEN GOTO Done;
Inc(BlkNum);
IF (Head=Syn) AND (BlkNum > 0) THEN Head:=Soh;
Errs:=0;
END ELSE
BEGIN
IF InChar=Nak THEN
BEGIN
Inc(Errs);
Inc(RealErrs);
Pause(5);
ComPort^.PurgeOut;
Message:='Nak';
END ELSE
BEGIN
IF ComPort^.Carrier THEN
BEGIN
IF NOT TimerExpired(BlockTimer) THEN
GOTO Reply
ELSE
BEGIN
Message:='TimeOut';
GOTO FUBAR;
END;
END ELSE
BEGIN
Message:='No Carrier';
GOTO FUBAR;
END;
END;
IF Errs > 10 THEN
BEGIN
Message:='FuBar';
GOTO FUBAR;
END;
IF BlkNum <= LastBlock THEN Temp:=BlkNum ELSE Temp:=LastBlock;
{ write again}
IF (Sliding) AND (ACKBlock > 0) THEN
BEGIN
IF SendACKLess THEN
BEGIN
{write *}
END ELSE
BEGIN
{write :}
END;
END;
IF Message <> '' THEN ShowError(Message,True,false,false);
END;
END;
END; {while}
Message:='No carrier';
FUBAR:
ComPort^.PurgeOut;
{sendcan}
AddLog('!', 'File NOT send');
Close(OutFile);
FreeMem(Buffer, BlockSize);
SendFile:=0;
Exit;
Done:
WHILE NOT ComPort^.OutEmpty DO ;
ComPort^.PurgeIn;
ComPort^.WriteByte(Eot, True);
ACKErr:=1;
BlkNum:=LastBlock + 1;
FOR i:=0 TO 4 DO
BEGIN
IF NOT ComPort^.Carrier THEN
BEGIN
ACKErr:=1;
GOTO GoHome;
END;
CASE TimedRead(500) OF
67,
Nak,
Can : BEGIN
InChar:=TimedRead(400);
IF (Sliding) AND (InChar >= 0) THEN
BEGIN
InChar1:=TimedRead(200);
IF InChar=(InChar1 XOR $ff) THEN
BEGIN
BlkNum:=BlkNum - (Lo(BlkNum - InChar));
ComPort^.PurgeIn;
IF BlkNum <= LastBlock THEN GOTO SendLoop;
END;
END;
ComPort^.PurgeIn;
ComPort^.WriteByte(Eot, True);
END;
TSync : BEGIN
ACKErr:=TSync;
GOTO GoHome;
END;
Ack : BEGIN
InChar:=TimedRead(400);
IF (Sliding) AND (InChar >= 0) THEN
BEGIN
InChar1:=TimedRead(200);
END;
ACKErr:=1;
GOTO GoHome;
END;
END;
END;
GoHome:
Close(OutFile);
FileSent(JustFileName(FName),'S',FALSE);
FreeMem(Buffer, BlockSize);
SendFile:=ACKErr;
END;
END.